home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / gnu / calc202a.lha / calc-2.02a / calc-store.el < prev    next >
Lisp/Scheme  |  1993-06-01  |  19KB  |  664 lines
  1. ;; Calculator for GNU Emacs, part II [calc-store.el]
  2. ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
  3. ;; Written by Dave Gillespie, daveg@synaptics.com.
  4.  
  5. ;; This file is part of GNU Emacs.
  6.  
  7. ;; GNU Emacs is distributed in the hope that it will be useful,
  8. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  9. ;; accepts responsibility to anyone for the consequences of using it
  10. ;; or for whether it serves any particular purpose or works at all,
  11. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  12. ;; License for full details.
  13.  
  14. ;; Everyone is granted permission to copy, modify and redistribute
  15. ;; GNU Emacs, but only under the conditions described in the
  16. ;; GNU Emacs General Public License.   A copy of this license is
  17. ;; supposed to have been given to you along with GNU Emacs so you
  18. ;; can know your rights and responsibilities.  It should be in a
  19. ;; file named COPYING.  Among other things, the copyright notice
  20. ;; and this notice must be preserved on all copies.
  21.  
  22.  
  23.  
  24. ;; This file is autoloaded from calc-ext.el.
  25. (require 'calc-ext)
  26.  
  27. (require 'calc-macs)
  28.  
  29. (defun calc-Need-calc-store () nil)
  30.  
  31.  
  32. ;;; Memory commands.
  33.  
  34. (defun calc-store (&optional var)
  35.   (interactive)
  36.   (let ((calc-store-keep t))
  37.     (calc-store-into var))
  38. )
  39. (setq calc-store-keep nil)
  40.  
  41. (defun calc-store-into (&optional var)
  42.   (interactive)
  43.   (calc-wrapper
  44.    (let ((calc-given-value nil)
  45.      (calc-given-value-flag 1))
  46.      (or var (setq var (calc-read-var-name "Store: " t)))
  47.      (if var
  48.      (let ((found (assq var '( ( + . calc-store-plus )
  49.                    ( - . calc-store-minus )
  50.                    ( * . calc-store-times )
  51.                    ( / . calc-store-div )
  52.                    ( ^ . calc-store-power )
  53.                    ( | . calc-store-concat ) ))))
  54.        (if found
  55.            (funcall (cdr found))
  56.          (calc-store-value var (or calc-given-value (calc-top 1))
  57.                    "" calc-given-value-flag)
  58.          (message "Stored to variable \"%s\"" (calc-var-name var))))
  59.        (setq var (calc-is-assignments (calc-top 1)))
  60.        (if var
  61.        (while var
  62.          (calc-store-value (car (car var)) (cdr (car var))
  63.                    (if (not (cdr var)) "")
  64.                    (if (not (cdr var)) 1))
  65.          (setq var (cdr var)))))))
  66. )
  67.  
  68. (defun calc-store-plus (&optional var)
  69.   (interactive)
  70.   (calc-store-binary var "+" '+)
  71. )
  72.  
  73. (defun calc-store-minus (&optional var)
  74.   (interactive)
  75.   (calc-store-binary var "-" '-)
  76. )
  77.  
  78. (defun calc-store-times (&optional var)
  79.   (interactive)
  80.   (calc-store-binary var "*" '*)
  81. )
  82.  
  83. (defun calc-store-div (&optional var)
  84.   (interactive)
  85.   (calc-store-binary var "/" '/)
  86. )
  87.  
  88. (defun calc-store-power (&optional var)
  89.   (interactive)
  90.   (calc-store-binary var "^" '^)
  91. )
  92.  
  93. (defun calc-store-concat (&optional var)
  94.   (interactive)
  95.   (calc-store-binary var "|" '|)
  96. )
  97.  
  98. (defun calc-store-neg (n &optional var)
  99.   (interactive "p")
  100.   (calc-store-binary var "n" '/ (- n))
  101. )
  102.  
  103. (defun calc-store-inv (n &optional var)
  104.   (interactive "p")
  105.   (calc-store-binary var "&" '^ (- n))
  106. )
  107.  
  108. (defun calc-store-incr (n &optional var)
  109.   (interactive "p")
  110.   (calc-store-binary var "n" '- (- n))
  111. )
  112.  
  113. (defun calc-store-decr (n &optional var)
  114.   (interactive "p")
  115.   (calc-store-binary var "n" '- n)
  116. )
  117.  
  118. (defun calc-store-value (var value tag &optional pop)
  119.   (if var
  120.       (let ((old (calc-var-value var)))
  121.     (set var value)
  122.     (if pop (or calc-store-keep (calc-pop-stack pop)))
  123.     (calc-record-undo (list 'store (symbol-name var) old))
  124.     (if tag
  125.         (let ((calc-full-trail-vectors nil))
  126.           (calc-record value (format ">%s%s" tag (calc-var-name var)))))
  127.     (and (memq var '(var-e var-i var-pi var-phi var-gamma))
  128.          (eq (car-safe old) 'special-const)
  129.          (message "(Note: Built-in definition of %s has been lost)" var))
  130.     (and (memq var '(var-inf var-uinf var-nan))
  131.          (null old)
  132.          (message "(Note: %s has built-in meanings which may interfere)"
  133.               var))
  134.     (calc-refresh-evaltos var)))
  135. )
  136.  
  137. (defun calc-var-name (var)
  138.   (if (symbolp var) (setq var (symbol-name var)))
  139.   (if (string-match "\\`var-." var)
  140.       (substring var 4)
  141.     var)
  142. )
  143.  
  144. (defun calc-store-binary (var tag func &optional val)
  145.   (calc-wrapper
  146.    (let ((calc-simplify-mode (if (eq calc-simplify-mode 'none)
  147.                  'num calc-simplify-mode))
  148.      (value (or val (calc-top 1))))
  149.      (or var (setq var (calc-read-var-name (format "Store %s: " tag))))
  150.      (if var
  151.      (let ((old (calc-var-value var)))
  152.        (or old
  153.            (error "No such variable: \"%s\"" (calc-var-name var)))
  154.        (if (stringp old)
  155.            (setq old (math-read-expr old)))
  156.        (if (eq (car-safe old) 'error)
  157.            (error "Bad format in variable contents: %s" (nth 2 old)))
  158.        (calc-store-value var
  159.                  (calc-normalize (if (calc-is-inverse)
  160.                          (list func value old)
  161.                            (list func old value)))
  162.                  tag (and (not val) 1))
  163.        (message "Stored to variable \"%s\"" (calc-var-name var))))))
  164. )
  165.  
  166. (defun calc-read-var-name (prompt &optional calc-store-opers)
  167.   (setq calc-given-value nil
  168.     calc-aborted-prefix nil)
  169.   (let ((var (let ((minibuffer-completion-table obarray)
  170.            (minibuffer-completion-predicate 'boundp)
  171.            (minibuffer-completion-confirm t))
  172.            (read-from-minibuffer prompt "var-" calc-var-name-map nil))))
  173.     (setq calc-aborted-prefix "")
  174.     (and (not (equal var ""))
  175.      (not (equal var "var-"))
  176.      (if (string-match "\\`\\([-a-zA-Z0-9]+\\) *:?=" var)
  177.          (if (null calc-given-value-flag)
  178.          (error "Assignment is not allowed in this command")
  179.            (let ((svar (intern (substring var 0 (match-end 1)))))
  180.          (setq calc-given-value-flag 0
  181.                calc-given-value (math-read-expr
  182.                      (substring var (match-end 0))))
  183.          (if (eq (car-safe calc-given-value) 'error)
  184.              (error "Bad format: %s" (nth 2 calc-given-value)))
  185.          (setq calc-given-value (math-evaluate-expr calc-given-value))
  186.          svar))
  187.        (intern var))))
  188. )
  189. (setq calc-given-value-flag nil)
  190.  
  191. (defvar calc-var-name-map nil "Keymap for reading Calc variable names.")
  192. (if calc-var-name-map
  193.     ()
  194.   (setq calc-var-name-map (copy-keymap minibuffer-local-completion-map))
  195.   (define-key calc-var-name-map " " 'self-insert-command)
  196.   (mapcar (function
  197.        (lambda (x)
  198.          (define-key calc-var-name-map (char-to-string x)
  199.            'calcVar-digit)))
  200.       "0123456789")
  201.   (mapcar (function
  202.        (lambda (x)
  203.          (define-key calc-var-name-map (char-to-string x)
  204.            'calcVar-oper)))
  205.       "+-*/^|")
  206. )
  207.  
  208. (defun calcVar-digit ()
  209.   (interactive)
  210.   (if (calc-minibuffer-contains "var-\\'")
  211.       (if (eq calc-store-opers 0)
  212.       (beep)
  213.     (insert "q")
  214.     (self-insert-and-exit))
  215.     (self-insert-command 1))
  216. )
  217.  
  218. (defun calcVar-oper ()
  219.   (interactive)
  220.   (if (and (eq calc-store-opers t)
  221.        (calc-minibuffer-contains "var-\\'"))
  222.       (progn
  223.     (erase-buffer)
  224.     (self-insert-and-exit))
  225.     (self-insert-command 1))
  226. )
  227.  
  228. (defun calc-store-map (&optional oper var)
  229.   (interactive)
  230.   (calc-wrapper
  231.    (let* ((sel-mode nil)
  232.       (calc-dollar-values (mapcar 'calc-get-stack-element
  233.                       (nthcdr calc-stack-top calc-stack)))
  234.       (calc-dollar-used 0)
  235.       (oper (or oper (calc-get-operator "Store Mapping")))
  236.       (nargs (car oper)))
  237.      (or var (setq var (calc-read-var-name (format "Store Mapping %s: "
  238.                            (nth 2 oper)))))
  239.      (if var
  240.      (let ((old (or (calc-var-value var)
  241.             (error "No such variable: \"%s\""
  242.                    (calc-var-name var))))
  243.            (calc-simplify-mode (if (eq calc-simplify-mode 'none)
  244.                        'num calc-simplify-mode))
  245.            (values (and (> nargs 1)
  246.                 (calc-top-list (1- nargs) (1+ calc-dollar-used)))))
  247.        (message "Working...")
  248.        (calc-set-command-flag 'clear-message)
  249.        (if (stringp old)
  250.            (setq old (math-read-expr old)))
  251.        (if (eq (car-safe old) 'error)
  252.            (error "Bad format in variable contents: %s" (nth 2 old)))
  253.        (setq values (if (calc-is-inverse)
  254.                 (append values (list old))
  255.               (append (list old) values)))
  256.        (calc-store-value var
  257.                  (calc-normalize (cons (nth 1 oper) values))
  258.                  (nth 2 oper)
  259.                  (+ calc-dollar-used (1- nargs)))))))
  260. )
  261.  
  262. (defun calc-store-exchange (&optional var)
  263.   (interactive)
  264.   (calc-wrapper
  265.    (let ((calc-given-value nil)
  266.      (calc-given-value-flag 1)
  267.      top)
  268.      (or var (setq var (calc-read-var-name "Exchange with: ")))
  269.      (if var
  270.      (let ((value (calc-var-value var)))
  271.        (or value
  272.            (error "No such variable: \"%s\"" (calc-var-name var)))
  273.        (if (eq (car-safe value) 'special-const)
  274.            (error "%s is a special constant" var))
  275.        (setq top (or calc-given-value (calc-top 1)))
  276.        (calc-store-value var top nil)
  277.        (calc-pop-push-record calc-given-value-flag
  278.                  (concat "<>" (calc-var-name var)) value)))))
  279. )
  280.  
  281. (defun calc-unstore (&optional var)
  282.   (interactive)
  283.   (calc-wrapper
  284.    (or var (setq var (calc-read-var-name "Unstore: ")))
  285.    (if var
  286.        (progn
  287.      (and (memq var '(var-e var-i var-pi var-phi var-gamma))
  288.           (eq (car-safe (calc-var-value var)) 'special-const)
  289.           (message "(Note: Built-in definition of %s has been lost)" var))
  290.      (if (and (boundp var) (symbol-value var))
  291.          (message "Unstored variable \"%s\"" (calc-var-name var))
  292.        (message "Variable \"%s\" remains unstored" (calc-var-name var)))
  293.      (makunbound var)
  294.      (calc-refresh-evaltos var))))
  295. )
  296.  
  297. (defun calc-let (&optional var)
  298.   (interactive)
  299.   (calc-wrapper
  300.    (let* ((calc-given-value nil)
  301.       (calc-given-value-flag 1)
  302.       thing value)
  303.      (or var (setq var (calc-read-var-name "Let variable: ")))
  304.      (if calc-given-value
  305.      (setq value calc-given-value
  306.            thing (calc-top 1))
  307.        (setq value (calc-top 1)
  308.          thing (calc-top 2)))
  309.      (setq var (if var
  310.            (list (cons var value))
  311.          (calc-is-assignments value)))
  312.      (if var
  313.      (calc-pop-push-record
  314.       (1+ calc-given-value-flag)
  315.       (concat "=" (calc-var-name (car (car var))))
  316.       (let ((saved-val (mapcar (function
  317.                     (lambda (v)
  318.                       (and (boundp (car v))
  319.                        (symbol-value (car v)))))
  320.                    var)))
  321.         (unwind-protect
  322.         (let ((vv var))
  323.           (while vv
  324.             (set (car (car vv)) (calc-normalize (cdr (car vv))))
  325.             (calc-refresh-evaltos (car (car vv)))
  326.             (setq vv (cdr vv)))
  327.           (math-evaluate-expr thing))
  328.           (while saved-val
  329.         (if (car saved-val)
  330.             (set (car (car var)) (car saved-val))
  331.           (makunbound (car (car var))))
  332.         (setq saved-val (cdr saved-val)
  333.               var (cdr var)))
  334.           (calc-handle-whys)))))))
  335. )
  336.  
  337. (defun calc-is-assignments (value)
  338.   (if (memq (car-safe value) '(calcFunc-eq calcFunc-assign))
  339.       (and (eq (car-safe (nth 1 value)) 'var)
  340.        (list (cons (nth 2 (nth 1 value)) (nth 2 value))))
  341.     (if (eq (car-safe value) 'vec)
  342.     (let ((vv nil))
  343.       (while (and (setq value (cdr value))
  344.               (memq (car-safe (car value))
  345.                 '(calcFunc-eq calcFunc-assign))
  346.               (eq (car-safe (nth 1 (car value))) 'var))
  347.         (setq vv (cons (cons (nth 2 (nth 1 (car value)))
  348.                  (nth 2 (car value)))
  349.                vv)))
  350.       (and (not value)
  351.            vv))))
  352. )
  353.  
  354. (defun calc-recall (&optional var)
  355.   (interactive)
  356.   (calc-wrapper
  357.    (or var (setq var (calc-read-var-name "Recall: ")))
  358.    (if var
  359.        (let ((value (calc-var-value var)))
  360.      (or value
  361.          (error "No such variable: \"%s\"" (calc-var-name var)))
  362.      (if (stringp value)
  363.          (setq value (math-read-expr value)))
  364.      (if (eq (car-safe value) 'error)
  365.          (error "Bad format in variable contents: %s" (nth 2 value)))
  366.      (setq value (calc-normalize value))
  367.      (let ((calc-full-trail-vectors nil))
  368.        (calc-record value (concat "<" (calc-var-name var))))
  369.      (calc-push value))))
  370. )
  371.  
  372. (defun calc-store-quick ()
  373.   (interactive)
  374.   (calc-store (intern (format "var-q%c" last-command-char)))
  375. )
  376.  
  377. (defun calc-store-into-quick ()
  378.   (interactive)
  379.   (calc-store-into (intern (format "var-q%c" last-command-char)))
  380. )
  381.  
  382. (defun calc-recall-quick ()
  383.   (interactive)
  384.   (calc-recall (intern (format "var-q%c" last-command-char)))
  385. )
  386.  
  387. (defun calc-copy-variable (&optional var1 var2)
  388.   (interactive)
  389.   (calc-wrapper
  390.    (or var1 (setq var1 (calc-read-var-name "Copy variable: ")))
  391.    (if var1
  392.        (let ((value (calc-var-value var1)))
  393.      (or value
  394.          (error "No such variable: \"%s\"" (calc-var-name var)))
  395.      (or var2 (setq var2 (calc-read-var-name
  396.                   (format "Copy variable: %s, to: " var1))))
  397.      (if var2
  398.          (calc-store-value var2 value "")))))
  399. )
  400.  
  401. (defun calc-edit-variable (&optional var)
  402.   (interactive)
  403.   (calc-wrapper
  404.    (or var (setq var (calc-read-var-name
  405.               (if calc-last-edited-variable
  406.               (format "Edit: (default %s) "
  407.                   (calc-var-name calc-last-edited-variable))
  408.             "Edit: "))))
  409.    (or var (setq var calc-last-edited-variable))
  410.    (if var
  411.        (let* ((value (calc-var-value var)))
  412.      (if (eq (car-safe value) 'special-const)
  413.          (error "%s is a special constant" var))
  414.      (setq calc-last-edited-variable var)
  415.      (calc-edit-mode (list 'calc-finish-stack-edit (list 'quote var))
  416.              t
  417.              (concat "Editing " (calc-var-name var)))
  418.      (and value
  419.           (insert (math-format-nice-expr value (screen-width)) "\n")))))
  420.   (calc-show-edit-buffer)
  421. )
  422. (setq calc-last-edited-variable nil)
  423.  
  424. (defun calc-edit-Decls ()
  425.   (interactive)
  426.   (calc-edit-variable 'var-Decls)
  427. )
  428.  
  429. (defun calc-edit-EvalRules ()
  430.   (interactive)
  431.   (calc-edit-variable 'var-EvalRules)
  432. )
  433.  
  434. (defun calc-edit-FitRules ()
  435.   (interactive)
  436.   (calc-edit-variable 'var-FitRules)
  437. )
  438.  
  439. (defun calc-edit-GenCount ()
  440.   (interactive)
  441.   (calc-edit-variable 'var-GenCount)
  442. )
  443.  
  444. (defun calc-edit-Holidays ()
  445.   (interactive)
  446.   (calc-edit-variable 'var-Holidays)
  447. )
  448.  
  449. (defun calc-edit-IntegLimit ()
  450.   (interactive)
  451.   (calc-edit-variable 'var-IntegLimit)
  452. )
  453.  
  454. (defun calc-edit-LineStyles ()
  455.   (interactive)
  456.   (calc-edit-variable 'var-LineStyles)
  457. )
  458.  
  459. (defun calc-edit-PointStyles ()
  460.   (interactive)
  461.   (calc-edit-variable 'var-PointStyles)
  462. )
  463.  
  464. (defun calc-edit-PlotRejects ()
  465.   (interactive)
  466.   (calc-edit-variable 'var-PlotRejects)
  467. )
  468.  
  469. (defun calc-edit-AlgSimpRules ()
  470.   (interactive)
  471.   (calc-edit-variable 'var-AlgSimpRules)
  472. )
  473.  
  474. (defun calc-edit-TimeZone ()
  475.   (interactive)
  476.   (calc-edit-variable 'var-TimeZone)
  477. )
  478.  
  479. (defun calc-edit-Units ()
  480.   (interactive)
  481.   (calc-edit-variable 'var-Units)
  482. )
  483.  
  484. (defun calc-edit-ExtSimpRules ()
  485.   (interactive)
  486.   (calc-edit-variable 'var-ExtSimpRules)
  487. )
  488.  
  489. (defun calc-declare-variable (&optional var)
  490.   (interactive)
  491.   (calc-wrapper
  492.    (or var (setq var (calc-read-var-name "Declare: " 0)))
  493.    (or var (setq var 'var-All))
  494.    (let* (dp decl def row rp)
  495.      (or (and (calc-var-value 'var-Decls)
  496.           (eq (car-safe var-Decls) 'vec))
  497.      (setq var-Decls (list 'vec)))
  498.      (setq dp var-Decls)
  499.      (while (and (setq dp (cdr dp))
  500.          (or (not (eq (car-safe (car dp)) 'vec))
  501.              (/= (length (car dp)) 3)
  502.              (progn
  503.                (setq row (nth 1 (car dp))
  504.                  rp row)
  505.                (if (eq (car-safe row) 'vec)
  506.                (progn
  507.                  (while
  508.                  (and (setq rp (cdr rp))
  509.                       (or (not (eq (car-safe (car rp)) 'var))
  510.                       (not (eq (nth 2 (car rp)) var)))))
  511.                  (setq rp (car rp)))
  512.              (if (or (not (eq (car-safe row) 'var))
  513.                  (not (eq (nth 2 row) var)))
  514.                  (setq rp nil)))
  515.                (not rp)))))
  516.      (setq unread-command-char ?\C-a
  517.        decl (read-string (format "Declare: %s  to be: " var)
  518.                  (and rp
  519.                   (math-format-flat-expr (nth 2 (car dp)) 0))))
  520.      (setq decl (and (string-match "[^ \t]" decl)
  521.              (math-read-exprs decl)))
  522.      (if (eq (car-safe decl) 'error)
  523.      (error "Bad format in declaration: %s" (nth 2 decl)))
  524.      (if (cdr decl)
  525.      (setq decl (cons 'vec decl))
  526.        (setq decl (car decl)))
  527.      (and (eq (car-safe decl) 'vec)
  528.       (= (length decl) 2)
  529.       (setq decl (nth 1 decl)))
  530.      (calc-record (append '(vec) (list (math-build-var-name var))
  531.               (and decl (list decl)))
  532.           "decl")
  533.      (setq var-Decls (copy-sequence var-Decls))
  534.      (if (eq (car-safe row) 'vec)
  535.      (progn
  536.        (setcdr row (delq rp (cdr row)))
  537.        (or (cdr row)
  538.            (setq var-Decls (delq (car dp) var-Decls))))
  539.        (setq var-Decls (delq (car dp) var-Decls)))
  540.      (if decl
  541.      (progn
  542.        (setq dp (and (not (eq var 'var-All)) var-Decls))
  543.        (while (and (setq dp (cdr dp))
  544.                (or (not (eq (car-safe (car dp)) 'vec))
  545.                (/= (length (car dp)) 3)
  546.                (not (equal (nth 2 (car dp)) decl)))))
  547.        (if dp
  548.            (setcar (cdr (car dp))
  549.                (append (if (eq (car-safe (nth 1 (car dp))) 'vec)
  550.                    (nth 1 (car dp))
  551.                  (list 'vec (nth 1 (car dp))))
  552.                    (list (math-build-var-name var))))
  553.          (setq var-Decls (append var-Decls
  554.                      (list (list 'vec
  555.                          (math-build-var-name var)
  556.                          decl)))))))
  557.      (calc-refresh-evaltos 'var-Decls)))
  558. )
  559.  
  560. (defun calc-permanent-variable (&optional var)
  561.   (interactive)
  562.   (calc-wrapper
  563.    (or var (setq var (calc-read-var-name "Save variable (default=all): ")))
  564.    (let (pos)
  565.      (and var (or (and (boundp var) (symbol-value var))
  566.           (error "No such variable")))
  567.      (set-buffer (find-file-noselect (substitute-in-file-name
  568.                       calc-settings-file)))
  569.      (if var
  570.      (calc-insert-permanent-variable var)
  571.        (mapatoms (function
  572.           (lambda (x)
  573.             (and (string-match "\\`var-" (symbol-name x))
  574.              (not (memq x calc-dont-insert-variables))
  575.              (calc-var-value x)
  576.              (not (eq (car-safe (symbol-value x)) 'special-const))
  577.              (calc-insert-permanent-variable x))))))
  578.      (save-buffer)))
  579. )
  580. (defvar calc-dont-insert-variables '(var-FitRules var-FactorRules
  581.                      var-CommuteRules var-JumpRules
  582.                      var-DistribRules var-MergeRules
  583.                      var-NegateRules var-InvertRules
  584.                      var-IntegAfterRules
  585.                      var-TimeZone var-PlotRejects
  586.                      var-PlotData1 var-PlotData2
  587.                      var-PlotData3 var-PlotData4
  588.                      var-PlotData5 var-PlotData6
  589.                      var-DUMMY
  590. ))
  591.  
  592. (defun calc-insert-permanent-variable (var)
  593.   (goto-char (point-min))
  594.   (if (search-forward (concat "(setq " (symbol-name var) " '") nil t)
  595.       (progn
  596.     (setq pos (point-marker))
  597.     (forward-line -1)
  598.     (if (looking-at ";;; Variable .* stored by Calc on ")
  599.         (progn
  600.           (delete-region (match-end 0) (progn (end-of-line) (point)))
  601.           (insert (current-time-string))))
  602.     (goto-char (- pos 8 (length (symbol-name var))))
  603.     (forward-sexp 1)
  604.     (backward-char 1)
  605.     (delete-region pos (point)))
  606.     (goto-char (point-max))
  607.     (insert "\n;;; Variable \""
  608.         (symbol-name var)
  609.         "\" stored by Calc on "
  610.         (current-time-string)
  611.         "\n(setq "
  612.         (symbol-name var)
  613.         " ')\n")
  614.     (backward-char 2))
  615.   (insert (prin1-to-string (calc-var-value var)))
  616.   (forward-line 1)
  617. )
  618.  
  619. (defun calc-insert-variables (buf)
  620.   (interactive "bBuffer in which to save variable values: ")
  621.   (save-excursion
  622.     (set-buffer buf)
  623.     (mapatoms (function
  624.            (lambda (x)
  625.          (and (string-match "\\`var-" (symbol-name x))
  626.               (not (memq x calc-dont-insert-variables))
  627.               (calc-var-value x)
  628.               (not (eq (car-safe (symbol-value x)) 'special-const))
  629.               (or (not (eq x 'var-Decls))
  630.               (not (equal var-Decls '(vec))))
  631.               (or (not (eq x 'var-Holidays))
  632.               (not (equal var-Holidays '(vec (var sat var-sat)
  633.                              (var sun var-sun)))))
  634.               (insert "(setq "
  635.                   (symbol-name x)
  636.                   " "
  637.                   (prin1-to-string
  638.                    (let ((calc-language
  639.                       (if (memq calc-language '(nil big))
  640.                       'flat
  641.                     calc-language)))
  642.                  (math-format-value (symbol-value x) 100000)))
  643.                   ")\n"))))))
  644. )
  645.  
  646. (defun calc-assign (arg)
  647.   (interactive "P")
  648.   (calc-slow-wrapper
  649.    (calc-binary-op ":=" 'calcFunc-assign arg))
  650. )
  651.  
  652. (defun calc-evalto (arg)
  653.   (interactive "P")
  654.   (calc-slow-wrapper
  655.    (calc-unary-op "=>" 'calcFunc-evalto arg))
  656. )
  657.  
  658. (defun calc-subscript (arg)
  659.   (interactive "P")
  660.   (calc-slow-wrapper
  661.    (calc-binary-op "sub" 'calcFunc-subscr arg))
  662. )
  663.  
  664.